home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Examples / Demos / Another Byte < prev    next >
Lisp/Scheme  |  1998-10-26  |  6KB  |  251 lines
  1. ; 2by3 trio for flute and 2 bass guitars: complete score
  2. ; commissioned by BBC Radio 3 for 'Another Byte'
  3. ; by Nigel Morgan
  4. ; to analyze the score double-click high-lighted keywords
  5.  
  6. (create-tonality full-dim 
  7.    '(c 4 d 4  d# 4 f 4 f# 4 g# 4 a 4 b 4 
  8. ;    a   b   c     d   e   f    g   h
  9.     c# 4 d# 4 e 4 f# 4 g 4 a 4 a# 4))  
  10. ;    i    j    k   l    m   n    o
  11.  
  12.  
  13. (setq m1 '(a a -b a) ; section 1
  14.       m2 '(= = = =)
  15.       m3 '(b a -b)
  16.       m4 '(b -d -c -b)
  17.       m5 '(-d d -c b -b)
  18.       m6 '(l k j i -c -b)
  19.       m7 '(= a c d)
  20.       m8 '(e f h)
  21.       m9 '(e f h o)
  22.       m10 '(e f h o l)
  23.       m11 '(e f o l h m)
  24.       codab1 '(= ap = =) ; coda
  25.       codab2 '(= a-p = =)
  26.       codaf '(= m = =)     
  27.       n1 '(a ae = ae) ; section 2
  28.       n2 '(= = hl =)
  29.       n3 '(= ae =)
  30.       n4 '(= hl =)
  31.       n5 '(= ae bf cg =)
  32.       n6 '(il = = = lp)
  33.       n7 '(b d f h o m k i)
  34. )
  35.  
  36. (setq set1a (append  m1 m2 m1 m3 ; 2/4 7/16
  37.                      m2 m1 m2 m4 ; 2/4 2/4
  38.                      m1 m3 m2 m5 ; 7/16 9/16
  39.                      m2 m4 m1 m6) ; 2/4 10/16
  40. ) 
  41.  
  42. (setq set1b (append  m2 m1 m2 m3 
  43.                      m1 m2 m1 m4
  44.                      m2 m3 m1 m5
  45.                      m1 m4 m2 m6)
  46. )
  47.  
  48. (setq set1c (append  m2 m7 m2 m8
  49.                      m7 m2 m7 m9
  50.                      m2 m8 m7 m10
  51.                      m7 m9 m2 m11)
  52. )
  53.  
  54. (setq set2a (append n1 n1 m1 n1 ; 2/4 2/4 ;; bass
  55.                     n2 n2 n3 n5 ; 2/4 8/16
  56.                     m7 m9 n4 n6 ; 2/4 8/16
  57.                     n2 n2 m10 n7) ; 2/4 5/16 8/16
  58. )
  59.  
  60. (setq set2b (append n2 n2 m7 n2 ; bass
  61.                     n1 n1 n4 n6
  62.                     m2 m7 m8 m5
  63.                     n1 n1 (reverse n6) n7)
  64. )
  65.  
  66. ;; flute material
  67.  
  68. (setq set1a/b (append set1c 
  69.                (find-change 
  70.                 (gen-random 0.1 (length set1a) 
  71.                             '(a -b b c -c d -d e f g h))))
  72. )
  73.  
  74. (setq set2a/b (find-change 
  75.                 (gen-random 0.1 (* (length set2a) 2) 
  76.                             '(b d f h o m k i)))
  77. )
  78.  
  79. ;; dynamics : sections 1 & 2
  80.  
  81. (setq v1 '(96 72 100 64)
  82.       v2 '(0 0 0 0)
  83.       v3 '(96 64 72)
  84.       v3h '(0 110 0)  
  85.       v4 '(100 54 64 74)
  86.       v5 '(110 54 64 74 110)
  87.       v6 '(112 64 74 96 74 84)
  88.       v7 '(32 45 54 64 74 84 94 110) 
  89.       codav '(0 127 0 0)
  90. )
  91.  
  92. (setq vel1a (append v1 v2 v1 v3 
  93.                     v2 v1 v2 v4 
  94.                     v1 v3 v2 v5
  95.                     v2 v4 v1 v6)
  96. )
  97.  
  98. (setq vel1b (append v2 v1 v2 v3 
  99.                     v1 v2 v1 v4
  100.                     v2 v3 v1 v5
  101.                     v1 v4 v2 v6)
  102. )
  103.  
  104. (setq vel2a/b (append v1 v1 v2 v1
  105.                       v1 v1 v3h v5
  106.                       v2 v1 v3h v5
  107.                       v1 v1 v5 v7)
  108. )
  109.  
  110. (setq vel2ci (append v2 v2 v2 v1
  111.                      v2 v2 v3 v5
  112.                      v2 v2 v3 v5
  113.                      v2 v2 v5 v7)
  114. )
  115.  
  116. (setq vel2cii (append v2 v1 v1 v2
  117.                       v2 v1 v3 v5
  118.                       v2 v1 v3 v5
  119.                       v2 v1 v5 v7)
  120. )
  121.  
  122. ;; section 3 : with free solos
  123.  
  124. (setq o1 '(a -p -b ae = = = = = = = = = = = = = -o o -b) ; 5/4
  125.       o2 '(= -b-g = = = -d-h -d-h =) ; 2/4
  126.       o3 '(a -b -c c b a g f e) ; 9/16
  127.       o4 '(= = = = = il = = m l k j o m k j = = = =) ; 5/4
  128.       o5 '(= -b b d f = = -c) ; 2/4
  129.       o6 '(= = = = f d b -b -d) ; 9/16
  130.       o1r (build-list '= (length o1)) ; 5/4
  131.       o2r (build-list '= (length o2)) ; 2/4
  132.       o7  (symbol-transpose 3 '(= e = e = = =))
  133.       o7r (build-list '= (length o7)) ; 7/16
  134. )
  135.       
  136. (setq set3a (append o1 o1 o1 o1 ; 5/4 5/4 5/4 5/4
  137.                     o2 o2 o2 o3 ; 2/4 2/4 2/4 9/16
  138.                     o1r o1r o4 o4 ; 5/4 5/4 5/4 5/4
  139.                     o2r o2r o5 o6 o6 o7r) ; 2/4 2/4 2/4 9/16 9/16 7/16
  140. ) 
  141.  
  142. (setq set3b (append o1r o1r o4 o4
  143.                     o2r o2r o5 o6
  144.                     o1 o1 o1 o1 
  145.                     o2 o2 o2 o3 (symbol-transpose 5 o3) o7r)
  146. ) 
  147.  
  148. (setq set3c (append o1r o1r o4 o4 
  149.                     o5 (symbol-inversion 'a o5) o2r o3
  150.                     o1r o1r o4 o4
  151.                     o5 (symbol-inversion 'c o5) o2r o3
  152.                     (symbol-transpose 3 o3) o7)
  153. )
  154.  
  155. ;; dynamics: section 3
  156.  
  157. (setq v8 (gen-repeat 5 '(74 64 84 100))
  158.       v9 '(96 100 64 74 84 96 110 112)
  159.       v10 '(32 42 52 62 72 82 92 102 112)
  160.       v11 '(0 120 0 120 0 0 0)
  161. )
  162.  
  163. (setq vel3 (append (gen-repeat 2 
  164.                                (append v8 v8 v8 v8
  165.                                        v9 v9 v9 v10)) v10 v11)
  166. )
  167.  
  168. (def-tonality
  169.  flute (activate-tonality 
  170.         (full-dim e 6) (full-dim e 6) (full-dim e 6) 
  171.         (full-dim e& 6) (full-dim e 6))
  172.  default (activate-tonality 
  173.           (full-dim e 3) (full-dim d& 3) (full-dim e 3) 
  174.           (full-dim f 3) (full-dim e 3))
  175. )
  176.  
  177. (def-symbol
  178.  flute (append 
  179.         set1a/b set2a/b set1a/b  ; section 1 & 2 & 1
  180.         set3c ; section 3
  181.         set1a/b ; section1
  182.         codaf); coda
  183.  
  184.  bass1 (append 
  185.         set1a set1b set2a set2b set1a set1b ; section 1 & 2 & 1
  186.         set3a ; section 3
  187.         set1a set1b  ; section 1
  188.         codab1) ; coda
  189.  bass2 (append 
  190.         set1b set1a set2b set2a set1b set1a 
  191.         set3b  
  192.         set1b set1a
  193.         codab2)
  194. )             
  195.  
  196. (def-length
  197.   default '(1/16)
  198. )
  199.  
  200. (def-zone
  201.  default (list (* (length (append set1a set1b)) 120) ; section 1
  202.                  (* (length (append set2a set2b)) 120) ; section 2
  203.                  (* (length (append set1a set1b)) 120) ; section 1
  204.                  (* (length set3a) 120) ; section 3
  205.                  (* (length (append set1a set1b)) 120) ; section 1
  206.                  (* 4 120)) ; coda
  207. )
  208.  
  209. (def-velocity
  210.  flute  (append 
  211.          vel1b vel1a vel2ci vel2cii vel1b vel1a 
  212.          vel3
  213.          vel1b vel1a codav)
  214.  bass1  (append 
  215.          vel1a vel1b vel2a/b vel2a/b vel1a vel1b 
  216.          vel3
  217.          vel1a vel1b codav)
  218.  bass2  (append 
  219.          vel1b vel1a vel2a/b vel2a/b vel1b vel1a 
  220.          vel3
  221.          vel1b vel1a codav) 
  222. )
  223.  
  224. (def-channel
  225.    flute 3
  226.    bass1 1
  227.    bass2 2
  228. )
  229.  
  230. (def-program gm-sound-set
  231.    flute flute
  232.    bass1 slap-bass-2
  233.    bass2 slap-bass-2
  234. )
  235.  
  236. (def-controller gm-controllers
  237.   (flute panning '((64)))
  238.   (bass1 panning '((16)))
  239.   (bass2 panning '((110)))
  240. )
  241.  
  242. (def-tempo 80)
  243.  
  244. (midiport :printer)
  245.  
  246. (compile-instrument-p "ccl;output:" "Another byte midi"
  247.   flute
  248.   bass1
  249.   bass2
  250. )
  251.